;; Copyright © 2016, cage
;; All rights reserved.

;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:

;;     * Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;;     * Redistributions in binary form must reproduce the above copyright
;; notice, this list of conditions and the following disclaimer in the
;; documentation and/or other materials provided with the distribution.

;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
;; THE POSSIBILITY OF SUCH DAMAGE.

(in-package :mu-kanren-goodies-test)

(defsuite mu-kanren-goodies-suite (tests-suite))

(defmacro define-mu-kanren-gd-test ((name) &body body)
  `(define-kanren-test (,name mu-kanren-goodies-suite)
     ,@body))

(define-mu-kanren-gd-test (ch-1.10)
  (run nil (q)
    +fail+)
  ())

(define-mu-kanren-gd-test (ch-1.11)
  (run nil (q)
      (== 't q))
    (t))

(define-mu-kanren-gd-test (ch-1.12)
  (run nil (q)
    +fail+
    (== 't q))
  ())

(define-mu-kanren-gd-test (ch-1.13-14)
   (run nil (q)
      +succeed+
      (== 't q))
    (t))

(define-mu-kanren-gd-test (ch-1.15-16)
  (run nil (r)
    +succeed+
    (== 'corn r))
  (corn))

(define-mu-kanren-gd-test (ch-1.17)
  (run nil (r)
    +fail+
    (== 'corn r))
  ())

(define-mu-kanren-gd-test (ch-1.18)
  (run nil (q)
    +succeed+
    (== 'nil q))
  (nil))

(define-mu-kanren-gd-test (ch-1.20)
  (run nil (q)
    (let ((x 't))
      (== nil x)))
  ())

(define-mu-kanren-gd-test (ch-1.21) ; no!
  (run nil (q)
    (let ((x nil))
      (== nil x)))
  (:_.0))

(define-mu-kanren-gd-test (ch-1.22)
  (run nil (x)
    (let ((x 'nil))
      (== 't x)))
  ())

(define-mu-kanren-gd-test (ch-1.23)
  (run nil (q)
    (fresh (x)
      (== 't x)
      (== 't q)))
  (t))

(define-mu-kanren-gd-test (ch-1.26)
  (run nil (q)
    (fresh (x)
      (== x 't)
      (== 't q)))
  (t))

(define-mu-kanren-gd-test (ch-1.27)
  (run nil (q)
    (fresh (x)
      (== x 't)
      (== q 't)))
  (t))

(define-mu-kanren-gd-test (ch-1.28)
  (run nil (x)
    +succeed+)
  (:_.0))

(define-mu-kanren-gd-test (ch-1.29)
  (run nil (x)
    (let ((x 'nil))
      (declare (ignorable x))
      (fresh (x)
	(== 't x))))
  (:_.0))

(define-mu-kanren-gd-test (ch-1.30)
  (run nil (r)
    (fresh (x y)
      (== (cons x (cons y '())) r)))
  ((:_.0 :_.1)))

(define-mu-kanren-gd-test (ch-1.31)
  (run nil (s)
    (fresh (tee u)
      (== (cons tee (cons u '())) s)))
  ((:_.0 :_.1)))

(define-mu-kanren-gd-test (ch-1.32)
  (run nil (r)
    (fresh (x)
      (let ((y x))
	(fresh (x)
	  (== (cons y (cons x (cons y '()))) r)))))
  ((:_.0 :_.1 :_.0)))

(define-mu-kanren-gd-test (ch-1.33)
  (run nil (r)
    (fresh (x)
      (let ((y x))
	(fresh (x)
	  (== (cons x (cons y (cons x '()))) r)))))
  ((:_.0 :_.1 :_.0)))

(define-mu-kanren-gd-test (ch-1.34)
  (run nil (q)
    (== 'nil q)
    (== 't q))
  ())

(define-mu-kanren-gd-test (ch-1.35)
  (run nil (q)
    (== 'nil q)
    (== 'nil q))
  (nil))

(define-mu-kanren-gd-test (ch-1.36)
  (run nil (q)
    (let ((x q))
      (== 't x)))
  (t))

(define-mu-kanren-gd-test (ch-1.37)
  (run nil (r)
    (fresh (x)
      (== x r)))
  (:_.0))

(define-mu-kanren-gd-test (ch-1.38)
  (run nil (q)
    (fresh (x)
      (== 't x)
      (== x q)))
  (t))

(define-mu-kanren-gd-test (ch-1.39)
  (run nil (q)
    (fresh (x)
      (== x q)
      (== 't x)))
  (t))

(define-mu-kanren-gd-test (ch-1.40)
  (run nil (q)
    (fresh (x)
      (== 't x)
      (== x q)))
  (t))
(define-mu-kanren-gd-test (ch-1.41)
  (run nil (q)
    (fresh (x)
    (== (eq x q) q)))
  (nil))

(define-mu-kanren-gd-test (ch-1.42)
  (run nil (q)
    (let ((x q))
      (fresh (q)
	(== (eq x q) x))))
  (nil))

(define-mu-kanren-gd-test (ch-1.43)
  (run nil (q)
    (cond (nil +succeed+)
	  (t +fail+))
    (== 't q))
  ())

(define-mu-kanren-gd-test (ch-1.44)
  (run nil (q)
    (conde (+fail+ +succeed+)
	   (else +fail+))
    (== 't q))
  ())

(define-mu-kanren-gd-test (ch-1.45)
  (run nil (q)
    (conde (+fail+ +fail+)
	   (else +succeed+))
    (== 't q))
  (t))

(define-mu-kanren-gd-test (ch-1.46)
  (run nil (q)
    (conde (+succeed+ +succeed+)
	   (else +fail+))
    (== 't q))
  (t))

(define-mu-kanren-gd-test (ch-1.47)
  (run nil (x)
    (conde ((== 'olive x) +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  (olive oil))

(define-mu-kanren-gd-test (ch-1.49)
  (run 1 (x)
    (conde ((== 'olive x) +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  (olive))

(define-mu-kanren-gd-test (ch-1.50)
  (run nil (x)
    (conde ((== 'virgin x) +fail+)
	   ((== 'olive x) +succeed+)
	   (+succeed+ +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  (olive :_.0 oil))

(define-mu-kanren-gd-test (ch-1.52)
  (run 2 (x)
    (conde ((== 'extra x) +succeed+)
	   ((== 'virgin x) +fail+)
	   ((== 'olive x) +succeed+)
	   ((== 'oil x) +succeed+)
	   (else +fail+)))
  (extra olive))

(define-mu-kanren-gd-test (ch-1.53)
  (run nil (r)
    (fresh (x y)
      (== 'split x)
      (== 'pea y)
      (== (cons x (cons y '())) r)))
  ((split pea)))

(define-mu-kanren-gd-test (ch-1.54)
  (run nil (r)
    (fresh (x y)
      (conde ((== 'split x) (== 'pea y))
	     ((== 'navy x) (== 'bean y))
	     (else +fail+))
      (== (cons x (cons y '())) r)))
  ((split pea)(navy bean)))

(define-mu-kanren-gd-test (ch-1.55)
  (run nil (r)
    (fresh (x y)
      (conde ((== 'split x) (== 'pea y))
	     ((== 'navy x) (== 'bean y))
	     (else +fail+))
      (== (cons x (cons y (cons 'soup '()))) r)))
  ((split pea soup) (navy bean soup)))
